home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / ooptut34.zip / TP / OOPTUTOR / COLLECT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-14  |  5KB  |  168 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
  2. {$M 16384,0,3000}
  3. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  4. {   Turbo Pascal 6.0    Demo program from the Turbo Vision Guide         }
  5. {                                                                        }
  6. {   TVGUID17.PAS        Copyright (c) 1990 by Borland International      }
  7. {                                                                        }
  8. {   Modified  9.8.91   and again  19.11.92      R Shaw                   }
  9. {                                                                        }
  10. {   Demo program from the Turbo Vision Guide to illustrate the use of    }
  11. {   Collections. The original Borland program has been modified to check }
  12. {   memory for a collection of objects (clients) using DOS Debug from    }
  13. {   the program by means of the Exec procedure.                          }
  14. {                                                                        }
  15. {   COLLECT.PAS  ->  .EXE                                                }
  16. {________________________________________________________________________}
  17.  
  18. program COLLECT;
  19.  
  20. uses DOS, Objects, Crt, Hex;
  21.  
  22. type
  23.   PClient = ^TClient;
  24.   TClient = object(TObject)
  25.     Account, Name, Phone: PString;
  26.     constructor Init(NewAccount, NewName, NewPhone: String);
  27.     destructor Done; virtual;
  28.     procedure Print; virtual;
  29.   end;
  30.  
  31. { TClient }
  32. constructor TClient.Init(NewAccount, NewName, NewPhone: String);
  33. begin
  34.   Account := NewStr(NewAccount);
  35.   Name := NewStr(NewName);
  36.   Phone := NewStr(NewPhone);
  37. end;
  38.  
  39. destructor TClient.Done;
  40. begin
  41.   DisposeStr(Account);
  42.   DisposeStr(Name);
  43.   DisposeStr(Phone);
  44. end;
  45.  
  46. procedure TClient.Print;
  47. begin
  48.   Writeln('  ',
  49.     Account^, '':10-Length(Account^),
  50.     Name^, '':20-Length(Name^),
  51.     Phone^, '':16-Length(Phone^));
  52. end;
  53.  
  54. { Use ForEach iterator to display client information }
  55.  
  56. procedure PrintAll(C: PCollection);
  57.  
  58. procedure CallPrint(P : PClient); far;
  59. begin
  60.   P^.Print;                   { Call Print method }
  61. end;
  62.  
  63. begin { Print }
  64.   Writeln;
  65.   Writeln('Client list:');
  66.   C^.ForEach(@CallPrint);     { Print each client }
  67. end;
  68.  
  69. { Use FirstThat iterator to search non-key field }
  70.  
  71. procedure SearchPhone(C: PCollection; PhoneToFind: String);
  72.  
  73. function PhoneMatch(Client: PClient): Boolean; far;
  74. begin
  75.   PhoneMatch := Pos(PhoneToFind, Client^.Phone^) <> 0;
  76. end;
  77.  
  78. var
  79.   FoundClient: PClient;
  80.  
  81. begin { SearchPhone }
  82.   Writeln;
  83.   FoundClient := C^.FirstThat(@PhoneMatch);
  84.   if FoundClient = nil then
  85.     Writeln('No client met the search requirement')
  86.   else
  87.   begin
  88.     Writeln('Found client:');
  89.     FoundClient^.Print;
  90.   end;
  91. end;
  92.  
  93.  
  94. Function DebugPath : Pathstr;
  95.  
  96. var
  97.   DPath : PathStr;
  98.  
  99. begin
  100.   DPath := '';
  101.   DPath := FSearch('DEBUG.EXE', GetEnv('PATH'));
  102.   If DPath = '' then DPath := FSearch('DEBUG.COM', GetEnv('PATH'));
  103.   If DPath = '' then
  104.      begin
  105.         writeln('DEBUG file not found. Please check your DOS system.');
  106.         writeln;
  107.         writeln('Press any key to continue: ');
  108.         repeat until keypressed;
  109.      end;
  110.   DebugPath := DPath;
  111. end;      {of Function DebugPath}
  112.  
  113.  
  114. var
  115.   ClientList: PCollection;
  116.  
  117.   reply     : char;
  118.   HeapOrgSeg,HeapOrgOfs          : word;
  119.   HeapOrgSegX,HeapOrgOfsX        : string;
  120.   HeapPtrSeg,HeapPtrOfs          : word;
  121.   HeapPtrSegX,HeapPtrOfsX        : string;
  122.   HeapOrg                        : ^integer;
  123.   i                              : integer;
  124.  
  125. begin
  126.   ClrScr;
  127.   Writeln('CHECK OF MEMORY FOR A COLLECTION OF CLIENTS.');
  128.   Writeln;
  129.   Mark(HeapOrg);
  130.   HeapOrgSeg := seg(HeapOrg^);
  131.   HeapOrgOfs := ofs(HeapOrg^);
  132.   for i := HeapOrgOfs to (HeapOrgOfs + 1000) do Mem[HeapOrgSeg:i] := 0;
  133.   dec2hex(HeapOrgSeg,HeapOrgSegX);
  134.   dec2hex(HeapOrgOfs,HeapOrgOfsX);
  135.   writeln('HeapOrg:    ',HeapOrgSegX,':',HeapOrgOfsX);
  136.  
  137.   ClientList := New(PCollection, Init(10, 5));
  138.  
  139.   { Build collection }
  140.   with ClientList^ do
  141.   begin
  142.     Insert(New(PClient, Init('90-177', 'Smith, John', '0987-4321')));
  143.     Insert(New(PClient, Init('91-101', 'Jones, Gareth' , '0789-9876')));
  144.     Insert(New(PClient, Init('91-102', 'McDonald, Ian' , '0788-1234')));
  145.     Insert(New(PClient, Init('91-103', 'Kelly, Sean' , '0787-4567')));
  146.     Insert(New(PClient, Init('91-104', 'Williams, David' , '0786-7654')));
  147.   end;
  148.  
  149.   HeapPtrSeg := seg(HeapPtr^);
  150.   HeapPtrOfs := ofs(HeapPtr^);
  151.   dec2hex(HeapPtrSeg,HeapPtrSegX);
  152.   dec2hex(HeapPtrOfs,HeapPtrOfsX);
  153.   writeln('HeapPtr:    ',HeapPtrSegX,':',HeapPtrOfsX);
  154.  
  155.   { Use ForEach iterator to print all }
  156.   PrintAll(ClientList);
  157.  
  158.   writeln;
  159.   writeln('DOS Debug now entered from program by means of Exec procedure.');
  160.   writeln('Please type D followed by a space and then the HeapOrg address, as above.');
  161.   writeln('Then continue to type D until end of collection. Then type Q.');
  162.   SwapVectors;
  163.   Exec(DebugPath,'');
  164.   If DosError <> 0 then writeln('Dos error # ',DosError);
  165.   SwapVectors;
  166.   Dispose(ClientList, Done);  { Clean up }
  167. end.
  168.